home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / print / isigns50.zip / SIGNS.PAS < prev    next >
Pascal/Delphi Source File  |  1989-10-02  |  30KB  |  623 lines

  1. {$N-}    {80287 not present}
  2. {$R+}    {Range checking on}
  3. {$S+}    {Stack checking on}
  4. {$I+}    {I/O checking on}
  5.  
  6. PROGRAM Signs;
  7. {******************************************************************************
  8. **
  9. **  Robert W. Bloom
  10. **
  11. **  Function:  This program reads input from the terminal and creates signs
  12. **          (horizontal) or banners (vertical) in a number of formats.  Output
  13. **          character fonts are read from a HP LaserJet-compatible 'soft' font file.
  14. **
  15. **  Notes:  Font files must be indexed with FontIndx.Pas before use.
  16. **          See Signs.DOC for more information
  17. **
  18. ******************************************************************************}
  19.  
  20. Uses
  21.   Crt, {Unit found in TURBO.TPL}
  22.   Printer2; {special unit}
  23.  
  24. {$i const}
  25. VAR
  26.          font_file : FILE OF CHAR;     {the soft font file}
  27.      font_ndx_file : FILE OF CHAR_INDEX_RECORD;  {index to above}
  28.          ndx_array : ARRAY [0..255] OF CHAR_INDEX_RECORD;
  29.   in_file,out_file : TEXT;             {files for input and output}
  30.        avail_width : INTEGER;          {width of output device}
  31.           out_line : OUT_LINE_REC;     {to build output lines}
  32.      gout_1,gout_2 : OUT_GRAPHIC_REC;  {output graphics lines}
  33.           gout_len : INTEGER;          {to build output graphic lines}
  34.           ptr_maps : POINTER;          {pointer to character maps}
  35.           map_size : INTEGER;          {size of the maps}
  36.       space_needed : INTEGER;          {approx width of output?}
  37.        page_offset : INTEGER;          {actual indent}
  38.            bit_cnt : INTEGER;          {counter for graphics output}
  39.  
  40. {************************* Procedures called *********************************}
  41.  
  42. PROCEDURE main;                                                   FORWARD;
  43.     PROCEDURE out_sign         (VAR inp_line : S255);             FORWARD;
  44.     PROCEDURE out_banner       (VAR inp_line : S255);             FORWARD;
  45.  
  46. PROCEDURE parm_menu;                                              FORWARD;
  47.     {PROCEDURE disp_?}
  48. PROCEDURE ask_parm;                                               FORWARD;
  49.     {PROCEDURE ask_?}
  50. PROCEDURE input_menu;                                             FORWARD;
  51.  
  52. {utilities:}
  53.     PROCEDURE gotorc(R,C : INTEGER);                              FORWARD;
  54.     PROCEDURE sak;                                                FORWARD;
  55.     PROCEDURE alt_inp(VAR alt_str : S14);                         FORWARD;
  56.     PROCEDURE putchr (chrs : S14);                                FORWARD;
  57.     PROCEDURE disp_fs;                                            FORWARD;
  58.     PROCEDURE init_ff (VAR ff,ffi : S14;VAR ok : BOOLEAN);        FORWARD;
  59.     PROCEDURE set_up_maps (VAR inp_line : S255);                  FORWARD;
  60.     PROCEDURE reset_maps (VAR ptr : POINTER);                     FORWARD;
  61.  
  62. {printer stuff:}
  63.     PROCEDURE avail_space;                                        FORWARD;
  64.     PROCEDURE set_up_prt  (reset_prt : BOOLEAN);                  FORWARD;
  65.     PROCEDURE out_char          (ochar,ichar,action : CHAR);      FORWARD;
  66.        PROCEDURE out_nline;                                       FORWARD;
  67.        PROCEDURE add_gline;                                       FORWARD;
  68.            PROCEDURE out_gl_ids;                                  FORWARD;
  69.            PROCEDURE out_gl_hp;                                   FORWARD;
  70.            PROCEDURE out_gl_ep;                                   FORWARD;
  71.  
  72.  
  73. {**************************** Program Start **********************************}
  74.  
  75. PROCEDURE main;
  76. LABEL finis,restrt;
  77. VAR ans2,ans : CHAR;        {entered char}
  78.   text_input : S255;        {to build line into}
  79.   alt_inp_strng : S14;         {return from alt-char builder}
  80.         done : BOOLEAN;     {flag}
  81.            i : INTEGER;     {loop control}
  82.   output_err : BOOLEAN;     {if can't output correctly}
  83. BEGIN
  84.     done := FALSE;
  85.     text_input := '';
  86.     space_needed := 0;
  87.     parm_menu;
  88.     ask_parm;
  89.     input_menu;
  90.     WHILE NOT done DO BEGIN
  91. restrt:
  92.         ans := READKEY;
  93.         CLREOL;
  94.         CASE ans OF
  95.             ^P : BEGIN            {change parameters}
  96.                      ask_parm;
  97.                      GOTORC(17,41); CLREOL;
  98.                      input_menu;
  99.                      IF sign_type = sign THEN BEGIN    {recalc cause font may}
  100.                          space_needed := given_offset; {have been changed}
  101.                          FOR i := 1 TO LENGTH(text_input) DO
  102.                              space_needed := space_needed +
  103.                                  (ndx_array[ORD(text_input[i])].delta_x * mult_w)
  104.                      END ELSE
  105.                          space_needed := (font_height * mult_h) + given_offset;
  106.                      {end}
  107.                      GOTORC(17,25); CLREOL; highvideo; WRITE(space_needed);
  108.                      GOTORC(19,25); CLREOL; highvideo; WRITE(text_input)
  109.                  END;
  110.          ^D,^C : done := TRUE;    {done program}
  111.             ^A : BEGIN
  112.                      alt_inp(alt_inp_strng);
  113.                      text_input := text_input + alt_inp_strng;
  114.                      GOTORC(19,25); CLREOL; highvideo; WRITE(text_input)
  115.                  END;
  116.          ^L,^F : BEGIN            {formfeed to printer}
  117.                      GOTORC(24,1);
  118.                      IF output_device = printr THEN BEGIN
  119.                          WRITE(lst,^L);
  120.                          WRITE('Formfeed sent to printer.')
  121.                      END ELSE
  122.                          WRITE('Output is not directed to printer!'^G);
  123.                      {end}
  124.                      sak;
  125.                      GOTORC(24,1); CLREOL;
  126.                      GOTORC(19,25); CLREOL; highvideo; WRITE(text_input)
  127.                  END;
  128.          ^R,^T : BEGIN            {move back to TOF (reverse formfeed)}
  129.                      GOTORC(24,1);
  130.                      IF output_device = printr THEN BEGIN
  131.                          WRITE('Moving print-head back to TOF.');
  132.                          CASE prt_type OF
  133.                              ids : WRITE(lst,CHR(27),'G0$',CHR(27),'H0$');
  134.                            epson : {not available?} ;
  135.                               hp : WRITE(lst,CHR(27),'&a0c0R')
  136.                          END {case}
  137.                      END ELSE
  138.                          WRITE('Output is not directed to printer!'^G);
  139.                      {end}
  140.                      sak;
  141.                      GOTORC(24,1); CLREOL;
  142.                      GOTORC(19,25); CLREOL; highvideo; WRITE(text_input)
  143.                  END;
  144.        ^H,#127 : BEGIN            {backspace once}
  145.                      IF LENGTH(text_input) > 0 THEN BEGIN
  146.                          ans2 := text_input[LENGTH(text_input)];
  147.                          DELETE(text_input,LENGTH(text_input),1);
  148.                          IF sign_type = sign THEN space_needed :=
  149.                              space_needed - (ndx_array[ORD(ans2)].delta_x * mult_w);
  150.                          GOTORC(17,25); CLREOL; highvideo; WRITE(space_needed);
  151.                          GOTORC(19,25); CLREOL; highvideo; WRITE(text_input)
  152.                      END
  153.                  END;
  154.             ^X : BEGIN            {cancel line, start over}
  155.                      text_input := '';
  156.                      IF sign_type = sign THEN
  157.                          space_needed := given_offset
  158.                      ELSE
  159.                          space_needed := (font_height * mult_h) + given_offset;
  160.                      {end}
  161.                      GOTORC(17,25); CLREOL; highvideo; WRITE(space_needed);
  162.                      GOTORC(19,25); CLREOL; highvideo
  163.                  END;
  164.             ^M : BEGIN            {go ahead, process input line}
  165.                      output_err := FALSE;
  166.                      IF (LENGTH(text_input) = 0) AND
  167.                          (input_device <> text_file) THEN BEGIN
  168.                          GOTORC(24,1); CLREOL;
  169.                          WRITE('Do you want to quit? (Y/N) -> '^G);
  170.                          ans2 := READKEY;
  171.                          GOTORC(24,1); CLREOL;
  172.                          IF ans2 IN ['y','Y'] THEN
  173.